Hyper Stacks 1994 May/Hyper Stacks (Pacific HiTech)(1994)[Mac].iso/HyperTalk/CopyFile XFCN/CopyFile.PAS

Pascal/Delphi Source File | 1988-12-16 | 5.4 KB | 168 lines | [TEXT/TPAS]

program CopyFile;
{
  This XFCN will copy the file named in params[1] into a new file in
  params[2].  Both filenames need to be complete path names to
  guarantee success.  In the event of failure, it returns the standard
  Macintosh error code.

  No warranty is made for this code, at all.  It has worked for me so far,
  and that's all I can say.  If you spot a bug, please drop me a note via
  FidoNet network mail to 1:100/523 (or on the EchoMac or MacDev echomail
  conferences), or via Compu$erve EasyPlex to [76012,300], or via U.S.
  Snail to J. Brad Hicks, 11215 Sugartrail, St. Louis, MO 63136 (in that order
  of preference).

  CopyFile was written and compiled in Turbo Pascal / Macintosh version 1.00A.
}
{Remember to change the resource ID to 20517 after compiling}

{$R-}
{$U-}
{$D PasXFCN}

USES Memtypes,QuickDraw,OSIntf,HyperXCmd;

PROCEDURE PasXFCN(paramPtr: XCmdPtr);
{$I Hard Disk:Turbo Pascal:XCMD Folder:XCmdGlue.inc}

  LABEL 9940,9950,9960,9970,9980,9985,9990,9999;

  CONST
    MaxBuff  = 32000;
    ParamErr =     1;

  VAR
    iData, iRF,                    { input fref numbers, data and resource  }
    oData, oRF      : integer;     { output fref numbers, data and resource }
    fileSize,                      { file size in bytes                     }
    i,blocks,                      { block number and number of blocks      }
    bytes           : longint;     { bytes read each operation              }
    p               : ParmBlkPtr;  { parameter block for low-level file i/o }
    iFInfo          : FInfo;       { file finder information, both files    }
    ignore,                        { temporary error code                   }
    errorCode       : OSErr;       { last error code (also result)          }
    iFName,oFName   : Str255;      { full file names, both files            }
    bitBucket       : Ptr;         { pointer to space for the i/o           }

  BEGIN

    with paramPtr^ do begin

      if paramCount <> 2 then
        begin
          errorCode := ParamErr;
          goto 9999
        end;
      ZeroToPas(params[1]^,iFName);
      ZeroToPas(params[2]^,oFName);

      bitBucket := NewPtr(MaxBuff);
      errorCode := MemError;
      if errorCode <> noErr then goto 9999;
      p := ParmBlkPtr(NewPtr(sizeof(ParamBlockRec)));
      errorCode := MemError;
      if errorCode <> noErr then goto 9990;

      errorCode := GetFInfo(iFName,0,iFInfo);
      if errorCode <> noErr then goto 9985 else begin

        errorCode := Create(oFName,0,iFInfo.fdCreator,iFInfo.fdType);
        if errorCode <> noErr then goto 9985;

     (* errorCode := FSOpen(iFName,0,iData); *)
        with p^ do begin
          ioCompletion := nil;   { no follow-on routine      }
          ioNamePtr := @iFName;  { pointer to path:file name }
          ioVRefNum := 0;        { dummy volume number       }
          ioVersNum := 0;        { version always = 0        }
          ioPermssn := fsRdPerm; { request read-only         }
          ioMisc    := nil       { use volume i/o buffer     }
        end {with};
        errorCode := PBOpen(p,false);
        if errorCode <> noErr then goto 9980;
        iData := p^.ioRefNum;

        errorCode := GetEOF(iData,fileSize);
        if errorCode <> noErr then goto 9970;

        if fileSize > 0 then begin

          errorCode := FSOpen(oFName,0,oData);
          if errorCode <> noErr then goto 9970;

          errorCode := Allocate(oData,fileSize);
          if errorCode <> noErr then goto 9960;

          blocks := (fileSize + MaxBuff - 1) div MaxBuff;
          for i := 1 to blocks do begin

            bytes := MaxBuff;
            errorCode := FSRead(iData,bytes,bitBucket);
            if (errorCode <> noErr) and (errorCode <> eofErr) then goto 9960;
            errorCode := FSWrite(oData,bytes,bitBucket);
            if errorCode <> noErr then goto 9960

          end {for}

        end {if};

     (* errorCode := OpenRF(iFName,0,iRF); *)
        with p^ do begin
          ioCompletion := nil;   { no follow-on routine      }
          ioNamePtr := @iFName;  { pointer to path:file name }
          ioVRefNum := 0;        { dummy volume number       }
          ioVersNum := 0;        { version always = 0        }
          ioPermssn := fsRdPerm; { request read-only         }
          ioMisc    := nil       { use volume i/o buffer     }
        end {with};
        errorCode := PBOpenRF(p,false);
        if errorCode <> noErr then goto 9960;
        iRF := p^.ioRefNum;

        errorCode := GetEOF(iRF,fileSize);
        if errorCode <> noErr then goto 9950;

        if fileSize > 0 then begin

          errorCode := OpenRF(oFName,0,oRF);
          if errorCode <> noErr then goto 9940;

          errorCode := Allocate(oRF,fileSize);
          if errorCode <> noErr then goto 9940;

          blocks := (fileSize + MaxBuff - 1) div MaxBuff;
          for i := 1 to blocks do begin

            bytes := MaxBuff;
            errorCode := FSRead(iRF,bytes,bitBucket);
            if (errorCode <> noErr) and (errorCode <> eofErr) then goto 9940;
            errorCode := FSWrite(oRF,bytes,bitBucket);
            if errorCode <> noErr then goto 9940

          end {for}

        end {if}

      end {else};

9940: ignore := FSClose(oRF);
9950: ignore := FSClose(iRF);
9960: ignore := FSClose(oData);
9970: ignore := FSClose(iData);
9980: if errorCode <> noErr then ignore := FSDelete(oFName,0);
9985: disposPtr(ptr(p));
9990: disposPtr(bitBucket);

9999: returnValue := PasToZero(NumToStr(errorCode))

    end {with}

  END;

BEGIN
END.